home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / A-Monthly Disks / (c)aai.d64 / merrimanager 3.2 (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  8KB  |  237 lines
  1. 5 REM           LIST 3000-
  2. 15 REM*********************************
  3. 20 REM*        MERRIMANAGER 3.2       *
  4. 25 REM*      RE=MAX. # OF RECORDS:-   *
  5. 30 REM*         NOW SET AT 300.       *
  6. 35 REM*DOES NOT RETAINS ORIGINAL ORDER*
  7. 40 REM*     WHEN SAVED TO DISK.       *
  8. 45 REM* DOES NOT PRINT RECORD NUMBERS *
  9. 50 REM*********************************
  10. 80 RE=300:FE=10:R=0:O$="BRFEADPLSCNM\X":DN$=""
  11. 90 DIMD$(RE,FE),D%(RE),FT$(FE):FI$="NEW FILE":PRINTCHR$(142)
  12. 96 :
  13. 98 REM** WARM START **
  14. 100 POKE53281,15:POKE646,11:CLOSE15:OPEN15,8,15
  15. 102 POKE53280,12:M=0:GOTO900
  16. 103 :
  17. 106 REM**  SORT  **
  18. 108 T=D%(K):D%(K)=D%(I):D%(I)=T:RETURN
  19. 110 PRINT"[147]                  SORT                  [146][144]"
  20. 112 PRINT"":FORK=1TOF:PRINT" "K"[157] [146] "FT$(K):NEXT
  21. 114 PRINT"ENTER NUMBER SHOWING":PRINT"CATEGORY TO SORT"
  22. 116 INPUT"(0 TO QUIT)  0[157][157][157]";FC:IFFC=0THENRETURN
  23. 118 IFFC>FTHENPRINT"[145][145][145]":GOTO116
  24. 120 PRINT"[147]          SORTING PLEASE WAIT":M=2^INT(LOG(R)/LOG(2))-1
  25. 122 FORJ=1TOR-M:I=J
  26. 124 K=I+M:IFD$(D%(I),FC)>D$(D%(K),FC)THENGOSUB108:I=I-M:IFI>.THEN124
  27. 126 NEXT:M=INT(M/2):IFM>.THEN122
  28. 128 RETURN
  29. 196 :
  30. 198 REM** LOAD **
  31. 200 PRINT"[147]                LOAD FILE               [146][144]":FK$=FI$
  32. 201 FI$=""
  33. 202 PRINT"            'RETURN' TO CANCEL          [146]"
  34. 203 PRINT"ENTER FILE NAME";:INPUT"   [157][157][157]";FI$:IFFI$=""THENFI$=FK$:RETURN
  35. 204 CLOSE8:OPEN8,8,8,"0:MM/"+FI$+",S,R":INPUT#15,E,A$:IFETHENFI$=FK$:GOTO938
  36. 205 PRINTLEFT$(DN$,21)"            PLEASE WAIT "
  37. 208 INPUT#8,FI$:INPUT#8,F:FORI=1TOF:INPUT#8,FT$(I):NEXT
  38. 210 FORI=1TORE:PRINTLEFT$(DN$,10)"READING RECORD # "I
  39. 212 D%(I)=I:FORJ=1TOF:INPUT#8,D$(I,J):NEXT:L=ST
  40. 214 IFL=.THENNEXT
  41. 216 IFL=64THENR=I:GOTO220
  42. 218 PRINT"BAD STATUS"L:FORX=1TO3000:NEXT:GOTO200
  43. 220 I=RE:NEXT:CLOSE8:RETURN
  44. 296 :
  45. 298 REM** SAVE **
  46. 300 PRINT"[147]                  SAVE                  [146][144]"
  47. 302 PRINT"EXISTING FILE: "FI$
  48. 304 PRINT"           'RETURN' TO CANCEL           "
  49. 306 PRINT"ENTER FILE NAME <= 13 CHARACTERS":INPUTZ$:IFZ$=""THENRETURN
  50. 308 IFZ$=FI$THENINPUT"SCRATCH ORIGINAL FILE  N[157][157][157]";A$:IFA$="N"THENRETURN
  51. 310 IFZ$=FI$THENPRINT#15,"S0:MM/"+FI$:PRINT"OLD "CHR$(34)Z$CHR$(34)" SCRATCHED"
  52. 312 INPUT#15,E,A$:IFE<>0ANDE<>1ANDE<>73THEN938
  53. 314 CLOSE8:OPEN8,8,8,"0:MM/"+Z$+",S,W":INPUT#15,E,A$:IFETHEN938
  54. 316 FI$=Z$:PRINT#8,FI$:PRINT#8,F:FORI=1TOF:PRINT#8,FT$(I):NEXTI
  55. 318 FORI=1TOR:FORJ=1TOF:IFD$(I,J)=""THEND$(I,J)="\"
  56. 320 PRINT#8,D$(D%(I),J):NEXTJ
  57. 322 PRINTLEFT$(DN$,14)"WRITING RECORD #"I
  58. 324 PRINT"OF NEW FILE "CHR$(34)FI$CHR$(34):NEXTI
  59. 326 CLOSE8:RETURN
  60. 396 :
  61. 398 REM** FIELD TITLES **
  62. 400 PRINT"[147]    NEW OR ADD OR CHANGE FIELD TITLES   [144]"
  63. 401 PRINT"           'RETURN' TO CANCEL           "
  64. 402 A=0:PRINT"ENTER NUMBER OF FIELDS"
  65. 403 PRINT"PER RECORD ( 1-"FE"):";:INPUTA$:IFVAL(A$)>FETHEN400
  66. 404 IFVAL(A$)=0THENRETURN
  67. 405 F=VAL(A$):PRINT"ENTER FIELD TITLES:"
  68. 406 FORI=1TOF:PRINTI;:INPUT"[157]";FT$(I):NEXT:RETURN
  69. 496 :
  70. 498 REM** BROWSE **
  71. 500 PRINT"[147]                 BROWSE                 [146][144]"
  72. 501 INPUT"BEGIN AT RECORD #  1[157][157][157]";S
  73. 502 IFS>RTHENPRINT" ONLY "R" RECORDS ":GOTO1005
  74. 503 FORJ=STOR
  75. 504 GOSUB550
  76. 506 PRINT""TAB(29)" C [146]ONTINUE":PRINTTAB(29)" Q [146]UIT";
  77. 507 INPUT"[144]  C[157][157][157]";A$:IFA$="Q"THENJ=R
  78. 508 NEXTJ:RETURN
  79. 550 PRINT"[147]RECORD #"J:FORK=1TOF:PRINTLEFT$(DN$,2*K+3)""FT$(K)
  80. 552 PRINTRIGHT$("   "+STR$(K),3)". "D$(D%(J),K):NEXTK:RETURN
  81. 596 :
  82. 598 REM** FIND **
  83. 600 PRINT"[147]             FIND A RECORD              [144]"
  84. 601 FU=0:S$=""
  85. 602 FORK=1TOF:PRINT" "K"[157] [146]"FT$(K):NEXT
  86. 603 PRINT"ENTER LINE # SHOWING":PRINT"CATEGORY TO SEARCH";:INPUT"  0[157][157][157]";FU
  87. 604 IFFU=0THENRETURN
  88. 606 IFFU>FTHENPRINT"[145][145][145][145][145][145]":GOTO603
  89. 610 INPUT"ENTER SEARCH VALUE";S$
  90. 612 L=LEN(S$):IFS$=""THENPRINT"[145][145]":GOTO610
  91. 620 FORJ=1TOR:IFLEFT$(D$(D%(J),FU),L)=S$THEN504
  92. 622 NEXT:RETURN
  93. 716 :
  94. 718 REM** ADD **
  95. 720 PRINT"[147]            ADDING RECORD #"R+1"[157]         ";
  96. 721 IF(R+1)<100THENPRINT" ";:IF(R+1)<10THENPRINT" ";
  97. 722 PRINT"[144]            'RETURN' TO CANCEL          [146]"
  98. 724 R=R+1:D%(R)=R:J=R:FORK=1TOF:D$(R,K)="":NEXT
  99. 726 FORI=1TOF:PRINTLEFT$(DN$,2*I+3)""FT$(I)
  100. 728 PRINTRIGHT$(" "+MID$(STR$(I),2),2)" .[157]";
  101. 730 INPUTD$(D%(J),I):IFLEFT$(D$(D%(J),1),1)=""THENR=R-1:D%(R)=R:J=R:RETURN
  102. 732 IFD$(D%(J),I)=""THEND$(D%(J),I)="\"
  103. 734 Z=0:IFSW=1THENSW=0:RETURN
  104. 736 NEXT
  105. 740 INPUT"ENTER LINE # OF ANY CHANGES:  0[157][157][157]";I:IFI>FTHENPRINT"[145][145]";:GOTO740
  106. 743 IFI=0THENRETURN
  107. 746 SW=1:PRINT""LEFT$(DN$,2*I+4);
  108. 748 GOSUB728:GOTO740
  109. 756 :
  110. 758 REM** EDIT & DELETE **
  111. 760 PRINT"[147]              DELETE RECORD             [146][144]"
  112. 761 IFI=4THENPRINT"[147]               EDIT RECORD              [146][144]"
  113. 762 INPUT"ENTER RECORD #    0[157][157][157]";J
  114. 763 IFJ=0THENRETURN
  115. 764 IFJ<1ORJ>RTHENPRINT"[145][145]";:GOTO760
  116. 765 GOSUB550:IFI=4THENZ=4:GOTO740:REM * EDIT *
  117. 778 PRINT" CAUTION NON RETRIEVABLE DELETE[144]"
  118. 780 DC$="M":INPUT" D [146]ELETE OR  M [146]ENU   M[157][157][157]";DC$
  119. 782 IFLEFT$(DC$,1)="M"THENRETURN
  120. 786 TE=D%(J):FORI=JTOR-1:D%(I)=D%(I+1):NEXT
  121. 788 FORK=1TOF:D$(TE,K)=D$(R,K):D$(R,K)="":NEXT
  122. 790 FORI=1TOR-1:IFD%(I)=RTHEND%(I)=TE:I=R
  123. 792 NEXT:D%(R)=0:R=R-1:PRINT"[147]OLD RECORD #"J"DELETED":GOTO1005
  124. 796 :
  125. 798 REM** PRINT **
  126. 800 PRINT"[147]              PRINT RECORDS             [146][144]"
  127. 801 OPEN12,4,15:CLOSE12:IFST<>0THENPRINT"[156]TURN ON PRINTER AND PRESS RETURN[144]"
  128. 803 IFST<>0THENGETA$:IFA$<>CHR$(13)THEN803
  129. 804 INPUT"ENTER STARTING RECORD #   [157][157][157]";S:IFS=0THENS=1
  130. 805 IFS>RTHEN807
  131. 806 PRINT"ENDING RECORD # 0";:INPUT"[157][157][157]";E:IFE<SORE=0THENPRINT"   ERROR":GOTO1005
  132. 807 IFE>RORS>RTHENPRINT"[147]        ONLY"STR$(R)" RECORDS ENTERED":GOTO1005
  133. 808 PRINT"[156]DO YOU WANT A TITLE? Y/N"
  134. 810 GETT$:IFT$=""THEN810
  135. 812 IFT$="Y"THEN PRINT"[144]PLEASE ENTER TITLE":INPUTC$
  136. 814 PRINT"[147]PRINT RECORDS[146][144]"
  137. 816 PRINT"HOLD <SPACE BAR> TO PAUSE"
  138. 818 CLOSE4:OPEN4,4:IFT$="Y"THENPRINT#4,CHR$(14)SPC(20-(LEN(C$)/2));C$:C$=""
  139. 820 PRINT#4,CHR$(15):PRINT#4,CHR$(17)
  140. 822 FORI=STOE
  141. 824 FORJ=1TOF:PRINT#4,D$(D%(I),J):NEXTJ
  142. 826 GETA$:IFA$=CHR$(32)THEN830
  143. 828 PRINT#4:GOSUB2000:NEXTI:CLOSE4:RETURN
  144. 830 PRINT"TO CONTINUE PRESS <C>":PRINT"TO END PRINT PRESS <E>"
  145. 832 GETA$:IFA$=""THEN832
  146. 834 IFA$="E"THENPRINT#4:CLOSE4:RETURN
  147. 836 IFA$="C"THENPRINT"[145][145][145]                     ":PRINT"                      ":GOTO828
  148. 838 GOTO832
  149. 896 :
  150. 898 REM** MENU **
  151. 900 PRINT"[147]          MERRIMANAGER 3.2              [146]";
  152. 901 PRINT"         [156] FILE: "FI$" [146][144]":PRINTR"/"RE
  153. 902 PRINT"  C [146] CHANGE HEADINGS OR START RECORDS"
  154. 903 PRINT"  L [146] LOAD OR  S [146] SAVE THE RECORDS"
  155. 904 PRINT"  F [146] FIND OR  E [146] EDIT A RECORD"
  156. 905 PRINT"  A [146] ADD OR   D [146] DELETE A RECORD"
  157. 906 PRINT"  B [146] BROWSE THRU RECORDS"
  158. 907 PRINT"  R [146] REARRANGE THE RECORDS (SORT)"
  159. 908 PRINT"  P [146] PRINT THE RECORDS"
  160. 909 PRINT"  M [146] MEMORY CHECK    \ [146] DIRECTORY"
  161. 910 PRINT"  X [146] EXIT PROGRAM    N [146] NEW FILE
  162. 911 [153]"  ENTER OPTION WAIT ?"
  163. 912 [161]A$:[139]A$[178]""[167]912
  164. 914 [129]J[178]1[164]14:[139][202](O$,J,1)[178]A$[167]I[178]J:J[178]14:[130]:[137]918
  165. 916 [130]:[137]912
  166. 918 [139]I[178]8[176]I[178]10[176]I[178]12[176]I[178]13[176]I[178]14[167]922
  167. 919 [139]I[178]5[175]F[177]0[167]922
  168. 920 [139]R[178]0[167][153]"LOAD NO RECORDS IN MEMORY    STOP L  OR STOP C STOP":[137]901
  169. 922 [145]I[141]500,110,600,760,720,760,800,200,300,400,1012,996,1052,1080
  170. 924 [137]900
  171. 934 :
  172. 936 [143]** DISK ERROR **
  173. 938 [153]"LOAD    ERROR ON DISKSTOP":[153]"";A$:[160]8:[160]15:[159]15,8,15,"U;"
  174. 940 [153][200](DN$,19):[133]"PRESS 'RETURN' KEY";A$:[142]
  175. 992 :
  176. 994 [143]** MEMORY **
  177. 996 [153]"LOAD              MEMORY CHECK              WAIT"
  178. 998 [153]"STOPPLEASE WAIT - FORCED GARBAGE COLLECTION"
  179. 1000 [153]"TAKE A BREAK - BELL WILL SOUND
  180. 1002 PRINT""FRE(0)"[157] [146]SPACES REMAIN":C=0:GOSUB2070
  181. 1005 PRINTLEFT$(DN$,21)"[144] PRESS 'RETURN' KEY";:INPUTA$:RETURN
  182. 1008 :
  183. 1010 REM** NEW FILE **
  184. 1012 PRINT"[147] ERASE ALL RECORDS IN MEMORY AND RE-RUN [144]"
  185. 1014 INPUT" ARE YOU SURE Y/N  N[157][157][157]";A$
  186. 1016 IFA$="Y"THENRUN
  187. 1018 RETURN
  188. 1048 :
  189. 1050 REM** DISK DIRECTORY **
  190. 1052 CLOSE8:OPEN8,8,0,"$0":INPUT#15,E,A$:IFETHEN938
  191. 1054 PRINT"[147]          DATA FILE DIRECTORY           [146][144]":C=0:D$=""
  192. 1056 GET#8,A$,A$
  193. 1058 GET#8,A$,A$:IFA$=""THENCLOSE8:GOTO1070
  194. 1060 GET#8,A$:IFA$<>""THEND$=D$+A$:GOTO1060
  195. 1062 IFMID$(D$,2,3)="MM/"THENA=5:GOTO1068
  196. 1064 IFMID$(D$,3,3)="MM/"THENA=6:GOTO1068
  197. 1066 D$="":GOTO1058
  198. 1068 PRINTMID$(D$,A,A+9):C=C+1:D$="":GOTO1058
  199. 1070 IFC=0THENPRINT"NO DATA FILES ON THIS DISK"
  200. 1072 GOTO1005
  201. 1076 :
  202. 1078 REM** EXIT PROGRAM **
  203. 1080 PRINT"[147]      ANY RECORDS WILL BE ERASED "
  204. 1082 IFF>0THENINPUT"[144]HAVE YOU SAVED THE RECORDS Y/N  N[157][157][157]";A$
  205. 1084 IFF=0THENINPUT"[144]ARE YOU SURE  Y/N  N[157][157][157]";A$
  206. 1088 IFA$="Y"THENCLOSE4:CLOSE8:CLOSE15
  207. 1089 IFA$="Y"THENPRINT"[147] ALL FILES CLOSED.":END
  208. 1090 RETURN
  209. 1980 :
  210. 1990 REM** AUTO PAGEING **
  211. 2000 IFI=STHENLI=63:RM=0:IFT$="Y"THENLI=62
  212. 2020 RM=RM+1:BAL=LI-RM*(F+1)
  213. 2025 IFBAL<FTHEN2050
  214. 2040 RETURN
  215. 2050 FORK=1TOBAL+2:PRINT#4,CHR$(13);
  216. 2060 NEXTK:LI=63:RM=0:RETURN
  217. 2068 REM** BELL **
  218. 2070 FORC=1TO3
  219. 2075 POKE54296,15:POKE54276,33:POKE54277,9:POKE54278,0
  220. 2080 POKE54273,51:POKE54272,97:FORD=1TO300:NEXT
  221. 2082 POKE54276,0:POKE54296,0:NEXT:RETURN
  222. 2090 END
  223. 3000 :
  224. 3002 : THIS IS A PUBLIC DOMAIN PROGRAM
  225. 3004 : RELEASED INTO THE PUBLIC DOMAIN
  226. 3006 : IN 1986 BY:
  227. 3008 :
  228. 3010 :          REX MERRITT
  229. 3012 :          2101 TRIMBLE ST.
  230. 3014 :          VANCOUVER, B.C.
  231. 3016 :          CANADA,  V6R 4H5
  232. 3018 :
  233. 3020 : IF YOU HAVE ANY QUESTIONS,
  234. 3022 : COMMENTS, OR SUGGESTIONS ABOUT
  235. 3024 : THIS PROGRAM, PLEASE FEEL FREE
  236. 3026 : TO WRITE.
  237.